#/usr/bin/perl
<<DOC; 
-------------------------------------------------------------------------

Action : parcours une arborescence de fil RSS, extrait et nettoie les contenus textuels des titres et des descriptions
en utilisant la bibliothèque XML::RSS.

Commande pour lancer le programme: perl xmlrss.pl REPERTOIRE_A_PARCOURIR RUBRIQUE_A_EXTRAIRE

ENTREE : le programme prend en entrée le nom du répertoire contenant les fichiers à traiter avec la rubrique 
SORTIE : le programme crée en sortie 2 fichiers:
			- un fichier au format txt
			- un fichier au format XML

-------------------------------------------------------------------------
DOC
#----------------------------------------------------------------------
#Appel de la bibliothèque XML::RSS
use XML::RSS;
#Utilisation de XML::RSS 
my $rss=new XML::RSS;

#On récupère dans 2 variables les arguments passés au programme :
my $rep="$ARGV[0]";	#pour le répertoire à traiter
my $rubrique = "$ARGV[1]";	#la rubrique souhaitée

# on s'assure que le nom du répertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;

#-----------------------------------------------------------

#on déclare et on ouvre les fichiers de sortie en mode écriture :
open(OUT,">:encoding(utf8)", "BAO1_sortie_$rubrique.txt"); 
open(OUTXML, ">:encoding(utf8)", "BAO1_sortiexml_$rubrique.xml");


#on écrit la tête du fichier XML :
print OUTXML "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n";


print OUTXML "<BAO_1>\n"; #Déclaration de la racine

#l'ensemble des données extraites
print OUTXML "<fichiers>\n";

#on initialise un compteur et une table de hachage pour traiter les éventuels doublons :
my %dico_des_titres =();
my $i = 0;

#-----------------------------------------------------------
#Appel d'un sous-programme qui va parcourir l'arborescence de manière récursive :
&parcoursarborescencefichiers($rep);
#on passe le repertoire contenant les fichiers à traiter en argument du sous-programme

#-----------------------------------------------------------
#fermeture des fichiers :
close(OUT); #fermeture du fichier texte

print OUTXML "\t</fichiers>\n";
print OUTXML "</BAO_1>\n";
close(OUTXML); #fermeture du fichier XML

exit;

#-----------------------------------------------------------

#Le sous-programme qui prend en argument le répertoire à traiter:
sub parcoursarborescencefichiers {
	#------------on récupère la racine du chemin
	#shift prend le premier élément de la liste et le renvoie :
	my $path = shift(@_);
	
	#------------ouverture du contenu du répertoire :
	#on sait que la racine est un dossier donc utilisation de "opendir"
	opendir(DIR, $path) or die "can't open $path: $!\n";
	
	#-----------lecture du répertoire :
	#renvoie une liste de ressources du répertoire
	my @files = readdir(DIR);#examiner la liste de ressources
	
	#fermeture du répertoire :
	closedir(DIR);
	
	#boucle sur chacun des éléments de la liste des ressources du répertoire:
	foreach my $file (@files) {	
		#on passe au fichier suivant si le fichier est caché : "." ou ".."
		next if $file =~ /^\.\.?$/;
		
		#reconstruction du chemin relatif où l'on se trouve :
		$file = $path."/".$file;
		
		#si le chemin relatif conduit à un répertoire :
		# -d permet de vérifier que $file est un répertoire
		if (-d $file) {	
			#si on est dans un répertoire, on recommence toute la procédure avec un nouvel argument (chemin que l'on vient de construire) :
			&parcoursarborescencefichiers($file);	#recurse!
		}
		
		#si le chemin relatif conduit à un fichier :
		#-f permet de vérifier que $fil est un fichier
		if (-f $file) {	
			#----------TRAITEMENT à réaliser sur chaque fichier :
			
			#-----------------------Lecture du fichier :
			#si le fichier a une EXTENSION XML et la RUBRIQUE passée en argument au programme :
			if ($file =~/$rubrique.+\.xml$/) {
				#incrémentation du compteur, message dans la console :
				print $i++, "Traitement de :", $file, "\n";
				print "##------------------------------------------##\n";
				
#-----BAO1 : perl - XML::RSS--------------------------------				
				#on parse le fichier :
				eval {$rss->parsefile($file);};
				#si il y a eu erreur
				if( $@ ) {     
					$@ =~ s/at \/.*?$//s; # remove module line number
					print STDERR "\nERROR in '$file':\n$@\n";
				}
				
				#-------------------Extraction :
				else {
					foreach my $item (@{$rss->{'items'}}) {
							#on extrait le titre
							my $titre = $item->{'title'};
							#on extrait la description
							my $description = $item->{'description'};
#-----------------------------------------------------------------------------					
						#---------------Nettoyage du texte :
						#A l'aide d'un autre sous-programme on nettoie les "cochonneries" des contenus textuels qu'on a extrait
						($titre, $description) = &nettoyage($titre, $description);
					
						#--------------Traitement des doublons :
						#si le titre n'existe pas dans le dictionnaire $dico_des_titres :
						if (!(exists $dico_des_titres{$titre} )) {
							#alors il n'y a pas de doublons et on effectue le traitement suivant :
							#on ajoute le titre et la description au dictionnaire
							$dico_des_titres{$titre}=$description ; 

							#Ecriture des fichiers de sortie :
							#------------VERSION TXT---------------------
							print OUT "TITRE : ", $titre,"\n";
							print OUT "DESCRIPTION :", $description,"\n";
							print OUT "-------\n";
						
							#------------VERSION XML---------------------
							print OUTXML "\t\t<item>\n" ;
							print OUTXML "\t\t\t<titre>$titre</titre>\n";
							print OUTXML "\t\t\t<description>$description</description>\n";
							print OUTXML "\t\t</item>\n";
						
							#message dans la console :
							print "$file est le", $i++,"\n";
						
							#si le titre existe déjà dans le dictionnaire, on ne fait rien
						}
					}
				}
			}
		}
    }
}

#----------------------------------------------

#le sous programme qui nettoie le contenu textuel extrait :
#Entrée : 2 variables textuelles
#Sortie : les 2 variables textuelles nettoyées
sub nettoyage {
	#récupérer ce qui a été passé en argument au programme : @ARGV 
	my $titre = $_[0];
	my $description = $_[1];
	
	#--------Nettoyage :
	#enlever les structures [CDATA[ ... ]]	
	$description=~s/^<;!\[CDATA\[//;
	$description=~s/\]\]&gt;$//;
	$titre=~s/^<;!\[CDATA\[//;
	$titre=~s/\]\]&gt;$//;
	
	#rempalcer le code par des guillemets simples :
	$description =~s/&#38;#39;/'/g;
	$titre =~s/&#38;#39;/'/g;
	
	#remplacer le code par des guillemets doubles :
	$description =~s/&#38;#34;/"/g;
	$titre =~s/&#38;#34;/"/g;
	
	#suppresion des balises
	$description =~s/&lt;.+?&gt;//g ;
	$titre =~s/&lt;.+?&gt;//g ;
	
	#remplacer & par "et":
	$description =~s/&/et/g ;
	$titre =~s/&/et/g ;
	
	#rajouter un point à la fin des titres
	$titre=~s/$/\./g;
	
	#renvoyer le contenu textuel nettoyé :
	return $titre, $description;
}